home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / sound / wavepl / wavplt.bas < prev   
BASIC Source File  |  1994-11-08  |  36KB  |  907 lines
  1. Option Explicit
  2. 'rdpj192
  3. '*********************************************************************
  4. '*                                                                   *
  5. '*                                                                   *
  6. '*   Waveform Spectrum Plot Research & Development Project  11-94    *
  7. '*                                                                   *
  8. '*                                                                   *
  9. '*********************************************************************
  10.  
  11. 'For use with Visual Basic for Windows Standard Edition or Pro Edition
  12.  
  13. 'Files needed on system for this program to work
  14. 'MMSystem.DLL  (included with Windows 3.1)
  15. 'ToolHelp.DLL  (included with Windows 3.1)
  16. 'CMDialog.VBX  (comes with VBWIN 3.0 )
  17.  
  18. 'The .mak project is ready to run as is.
  19.  
  20. 'The purpose of this project is allow VBWIN programmers to plot waveform
  21. 'files(.wav) in their multimedia applications.
  22.  
  23. 'This small R & D application will load most waveform .wav files and then
  24. 'proceed to plot a static representation of the wave in the picture box.
  25. 'Press the Full Screen Plot button to plot the wave full screen.
  26.  
  27. 'Included with this download is a wave file Clock.WAV,use this file
  28. 'first.This is an excellent example for using the plotter, especially
  29. 'the full screen plot.
  30.  
  31. 'Take a look at PlotaWave Function,this is the code that does the plotting.
  32. 'currently only 8 bit mono and 16 bit mono 11025 kHz,22050 kHz and 44100 kHz
  33. 'are set for plotting,this covers a large majority of wave files out there
  34.  
  35. 'Most of the code to extract the Stereo formats is in PlotaWave Function
  36. 'but you need to set up the code that does the actual stereo plotting.
  37.  
  38. 'If you use part of the code from this project in your application,make
  39. 'sure you use the CloseWavePlay procedure each time after playing wave file
  40. 'this will free up the memory block reserved by Windows to hold wave file
  41. 'if you don't eventually you will run out of memory.This project as is
  42. 'already does so.
  43.  
  44. 'The code is far from perfect,but with a little tweaking and diligence
  45. 'you can customize to your needs.The size of the picture box can be any
  46. 'height and width,the PlotaWave Function will adjust automatically to any
  47. 'size,the wider the picture box the more detailed the plot will be.
  48.  
  49. 'In your Project
  50. 'Use Picture box controls for the time position instead of a label control.
  51. 'Label controls used for updating a high speed display will cause lots of
  52. 'flickering.The time updates over 60 times a second
  53.  
  54. 'In the PlotaWave function you will notice there are two methods used to
  55. 'do the plotting,LINE for the small picturebox and PSET for the full
  56. 'screen,the PSet offers more detail but may not be prefered,you can use
  57. 'LINE to plot full screen just as well
  58.  
  59. 'The code under the Play wo Timeclock command button is an alternate method
  60. 'to play a wavefile(.wav) without any time updates etc.
  61.  
  62. 'Regarding accurracy & Quality of the plotted Waveform file:
  63. 'I have compared the wave plot to several commercial applications
  64. 'and notice very little difference,some(comm. apps) are actually inferior
  65.  
  66.  
  67. 'Regarding MS ADPCM wave files
  68. '********************************************************************
  69. 'This program will NOT read any MS ADPCM files,these are 16 bit
  70. 'compressed files reduced to 4 or 8 bit.they usually have a format tag of 2
  71.  
  72. 'I have made a Function called checkformat that checks for a MS ADPCM
  73. 'wave file,they have a format tag of 2,currently having problems trying
  74. 'to read these files and then successfully closing the device which is
  75. 'neccessary to reopen the next file.
  76.  
  77. 'The program as is will not proceed to OpenWaveFile procedure unless the
  78. 'wave file has a format tag of 1.
  79.  
  80. 'you can Rem out the function call to checkformat in the OpenOption_click event
  81. 'procedure and try to get it to work.Some sound cards/drivers might allow
  82. 'loading,mine does not(SB 2.0)
  83.  
  84. '*********************************************************************
  85.  
  86. 'if you have already run the program you have noticed that the wave plot
  87. 'is a Static plot only.I am currently working on a Dynamic plot,a dynamic
  88. 'plotted wave shows while being played(as seen in the Windows 3.1 Sound Recorder)
  89.  
  90. 'Anyone with tips on plotting dynamically in VB please post a
  91. 'bulletin,E-Mail or whatever.
  92.  
  93.  
  94. Type SMPTE
  95.     hour As String * 1          '  hours
  96.     min As String * 1           '  minutes
  97.     sec As String * 1           '  seconds
  98.     frame As String * 1         '  frames
  99.     fps As String * 1           '  frames per second
  100.     dummy As String * 1         '  pad
  101. End Type
  102.  
  103. Type MMTIME
  104.     wType As Integer        '  indicates the contents of units
  105.     units As Long           '  (msecs, samples, bytes)
  106.     SMPTEVal As SMPTE
  107.     songptrpos As Long      '  song pointer position
  108. End Type
  109.  
  110. Type WAVEOUTCAPS
  111.     wMid As Integer
  112.     wPid As Integer
  113.     vDriverVersion As Integer
  114.     szPName As String * 32
  115.     dwFormats As Long
  116.     wChannels As Integer
  117.     dwSupport As Long
  118. End Type
  119.  
  120. Type WAVEFORMAT
  121.     wFormatTag As Integer
  122.     nChannels As Integer
  123.     nSamplesPerSec As Long
  124.     nAvgBytesPerSec As Long
  125.     nBlockAlign As Integer
  126. End Type
  127.  
  128. Type PCMWAVEFORMAT
  129.     wf As WAVEFORMAT
  130.     wBitsPerSample As Integer
  131. End Type
  132.  
  133. Type WAVEHDR
  134.     lpData As Long
  135.     dwBufferLength As Long
  136.     dwBytesRecorded As Long
  137.     dwUser As Long
  138.     dwFlags As Long
  139.     dwLoops As Long
  140.     lpNext As Long
  141.     reserved As Long
  142. End Type
  143.  
  144. Type FOURCC
  145.     Chars As String * 4
  146. End Type
  147.  
  148. Type MMIOINFO
  149.     dwFlags As Long
  150.     fccIOProc As FOURCC
  151.     lpIOProc As Long
  152.     wErrorRet As Integer
  153.     wReserved As Integer
  154.     ' Fields maintained by MMIO functions during buffered IO
  155.     cchBuffer As Long
  156.     pchBuffer As Long
  157.     pchNext As Long
  158.     pchEndRead As Long
  159.     pchEndWrite As Long
  160.     lBufOffset As Long
  161.     ' Fields maintained by I/O procedure
  162.     lDiskOffset As Long
  163.     adwInfo As String * 12
  164.     ' Other fields maintained by MMIO
  165.     dwReserved1 As Long
  166.     dwReserved2 As Long
  167.     hMMIO As Integer
  168. End Type
  169.  
  170. ' RIFF chunk information data structure
  171. Type MMCKINFO
  172.     CkId As FOURCC
  173.     CkSize As Long
  174.     fccType As FOURCC
  175.     dwDataOffset As Long
  176.     dwFlags As Long
  177. End Type
  178.  
  179. Type MonoEightBitSamples
  180.     Char As String * 1
  181. End Type
  182.  
  183. Type StereoEightBitSamples
  184.     LeftChar As String * 1
  185.     RightChar As String * 1
  186. End Type
  187.  
  188. Type MonoSixteenBitSamples
  189.     Sample As Integer
  190. End Type
  191.  
  192. Type StereoSixteenBitSamples
  193.     LeftSample As Integer
  194.     RightSample As Integer
  195. End Type
  196.  
  197. Declare Function waveOutReset Lib "MMSYSTEM" (ByVal hWaveOut As Integer) As Integer
  198. Declare Function waveOutGetDevCaps Lib "MMSystem" (ByVal wDeviceID As Integer, lpCaps As WAVEOUTCAPS, ByVal wSize As Integer) As Integer
  199. Declare Function waveOutOpen Lib "MMSystem" (lphWaveOut As Integer, ByVal wDeviceID As Integer, lpFormat As Any, ByVal dwCallBack As Long, ByVal dwCallBack As Long, ByVal dwFlags As Long) As Integer
  200. Declare Function waveOutClose Lib "MMSystem" (ByVal hWaveOut As Integer) As Integer
  201. Declare Function waveOutPrepareHeader Lib "MMSystem" (ByVal hWaveOut As Integer, lpWaveOutHdr As Any, ByVal wSize As Integer) As Integer
  202. Declare Function waveOutUnprepareHeader Lib "MMSystem" (ByVal hWaveOut As Integer, lpWaveOutHdr As Any, ByVal wSize As Integer) As Integer
  203. Declare Function waveOutWrite Lib "MMSystem" (ByVal hWaveOut As Integer, lpWaveOutHdr As Any, ByVal wSize As Integer) As Integer
  204. Declare Function waveOutGetPosition Lib "MMSYSTEM" (ByVal hWaveOut As Integer, lpinfo As MMTIME, ByVal uSize As Integer) As Integer
  205.  
  206.  
  207. Declare Function mmioOpen Lib "MMSystem" (ByVal szFilename As String, lpMMIOINFO As Any, ByVal dwOpenFlags As Long) As Integer
  208. Declare Function mmioClose Lib "MMSystem" (ByVal hMMIO As Integer, ByVal wFlags As Integer) As Integer
  209. Declare Function mmioDescend Lib "MMSystem" (ByVal hMMIO As Integer, lpCk As Any, lpCkParent As Any, ByVal wFlags As Integer) As Integer
  210. Declare Function mmioAscend Lib "MMSystem" (ByVal hMMIO As Integer, lpCk As Any, ByVal wFlags As Integer) As Integer
  211. Declare Function mmioRead Lib "MMSystem" (ByVal hMMIO As Integer, pCh As Any, ByVal cCh As Long) As Long
  212. Declare Function mmioReadToGlobal Lib "MMSystem" Alias "mmioRead" (ByVal hMMIO As Integer, ByVal lpBuffer As Long, ByVal cCh As Long) As Long
  213.  
  214. Declare Function lstrcpy Lib "Kernel" (lpString1 As Any, lpString2 As Any) As Long
  215.  
  216. Declare Function GlobalAlloc Lib "Kernel" (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer
  217. Declare Function GlobalHandleToSel Lib "ToolHelp.DLL" (ByVal hMem As Integer) As Integer
  218. Declare Function MemoryWrite Lib "ToolHelp.DLL" (ByVal wSel As Integer, ByVal dwOffSet As Long, lpvBuf As Any, ByVal dwcb As Long) As Long
  219. Declare Function MemoryRead Lib "ToolHelp.DLL" (ByVal wSel As Integer, ByVal dwOffSet As Long, lpvBuf As Any, ByVal dwcb As Long) As Long
  220. Declare Function GlobalFree Lib "Kernel" (ByVal hMem As Integer) As Integer
  221. Declare Function AnsiNext Lib "User" (ByVal lpString As String) As Long
  222. Declare Function GlobalLock Lib "Kernel" (ByVal hMem As Integer) As Long
  223. Declare Function GlobalUnlock Lib "Kernel" (ByVal hMem As Integer) As Integer
  224. Declare Sub hmemcpy Lib "Kernel" (ByVal lpDest As Long, ByVal lpSrc As Long, ByVal BytesToCopy As Long)
  225.  
  226.  
  227. Declare Function mmsystemGetVersion Lib "MMSYSTEM" () As Integer
  228. Declare Function mciexecute Lib "mmsystem" (ByVal lpstrCommand As String) As Integer
  229. Declare Function mciSendCommand Lib "mmsystem" (ByVal udeviceid As Integer, ByVal uMessage As Integer, ByVal dwParam1 As Long, ByVal dwParam2 As Long) As Long
  230. Declare Function mcisendstring Lib "mmsystem" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hWndCallback As Integer) As Long
  231. Declare Function mciGetErrorString Lib "mmsystem" (ByVal wError As Long, ByVal lpstrBuffer As String, ByVal uLength As Integer) As Integer
  232.  
  233. Declare Function sndPlaySound Lib "MMSYSTEM" (ByVal lpszSoundName As String, ByVal uFlags As Integer) As Integer
  234.  
  235.  
  236.  
  237. Global wavepath As String
  238.  
  239. Global PCMWaveFmtRecord As PCMWAVEFORMAT
  240. Global hWaveSampleData As Integer
  241. Dim hWaveOut As Integer
  242. Dim WaveHeader As WAVEHDR
  243. Global plotpos As Integer
  244. Global plottime As Single
  245.  
  246. 'used for sndPlaySound
  247. Global Const SND_SYNC = &H0                 '  play synchronously (default)
  248. Global Const SND_ASYNC = &H1                '  play asynchronously
  249. Global Const SND_NODEFAULT = &H2            '  don't use default sound
  250. Global Const SND_MEMORY = &H4               '  lpszSoundName points to a memory file
  251. Global Const SND_LOOP = &H8                 '  loop the sound until next sndPlaySound
  252. Global Const SND_NOSTOP = &H10              '  don't stop any currently playing sound
  253.  
  254.  
  255. Global Const GMEM_MOVEABLE = &H2
  256. Global Const GMEM_ZEROINIT = &H40
  257.  
  258. Global Const WAVE_MAPPER = -1        ' Device ID for Wave Mapper
  259. Global Const MMIO_READ = &H0&
  260. Global Const MMIO_WRITE = &H1&
  261. Global Const MMIO_READWRITE = &H2&
  262. Global Const MMIO_FINDCHUNK = &H10   ' mmioDescend: find a chunk by ID
  263. Global Const MMIO_FINDRIFF = &H20    ' mmioDescend: find a LIST chunk
  264.  
  265. Global Const WHDR_DONE = &H1         ' done bit
  266.  
  267. ' flags for dwFlags parameter in waveOutOpen() and waveInOpen()
  268. Global Const WAVE_FORMAT_QUERY = &H1
  269. Global Const TWIPS = 1
  270. Global Const WAVECAPS_PITCH = &H1           ' Supports pitch control
  271. Global Const WAVECAPS_PLAYBACKRATE = &H2    ' Supports playback rate control
  272. Global Const WAVECAPS_VOLUME = &H4          ' Supports volume control
  273. Global Const WAVECAPS_LRVOLUME = &H8        ' Supports separate left-right volume control
  274. Global Const WAVECAPS_SYNC = &H10
  275.  
  276. '  types for wType field in MMTIME struct
  277. Global Const TIME_MS = &H1              '  time in milliseconds
  278. Global Const TIME_SAMPLES = &H2         '  number of wave samples
  279. Global Const TIME_BYTES = &H4           '  current byte offset
  280. Global Const TIME_SMPTE = &H8           '  SMPTE time
  281. Global Const TIME_MIDI = &H10           '  MIDI time
  282.  
  283. ' MsgBox parameters
  284. Global Const MB_OK = 0                 ' OK button only
  285. Global Const MB_OKCANCEL = 1           ' OK and Cancel buttons
  286. Global Const MB_ABORTRETRYIGNORE = 2   ' Abort, Retry, and Ignore buttons
  287. Global Const MB_YESNOCANCEL = 3        ' Yes, No, and Cancel buttons
  288. Global Const MB_YESNO = 4              ' Yes and No buttons
  289. Global Const MB_RETRYCANCEL = 5        ' Retry and Cancel buttons
  290.  
  291. Global Const MB_ICONSTOP = 16          ' Critical message
  292. Global Const MB_ICONQUESTION = 32      ' Warning query
  293. Global Const MB_ICONEXCLAMATION = 48   ' Warning message
  294. Global Const MB_ICONINFORMATION = 64   ' Information message
  295.  
  296. ' MsgBox return values
  297. Global Const IDOK = 1                  ' OK button pressed
  298. Global Const IDCANCEL = 2              ' Cancel button pressed
  299. Global Const IDABORT = 3               ' Abort button pressed
  300. Global Const IDRETRY = 4               ' Retry button pressed
  301. Global Const IDIGNORE = 5              ' Ignore button pressed
  302. Global Const IDYES = 6                 ' Yes button pressed
  303. Global Const IDNO = 7                  ' No button pressed
  304.  
  305.  
  306. Global Const WAVE_INVALIDFORMAT = &H0 ' Invalid Format
  307. Global Const WAVE_FORMAT_1M08 = &H1   ' 11.025 kHz, Mono,   8 bit
  308. Global Const WAVE_FORMAT_1S08 = &H2   ' 11.025 kHz, Stereo, 8 bit
  309. Global Const WAVE_FORMAT_1M16 = &H4   ' 11.025 kHz, Mono,   16 bit
  310. Global Const WAVE_FORMAT_1S16 = &H8   ' 11.025 kHz, Stereo, 16 bit
  311. Global Const WAVE_FORMAT_2M08 = &H10  ' 22.05  kHz, Mono,   8 bit
  312. Global Const WAVE_FORMAT_2S08 = &H20  ' 22.05  kHz, Stereo, 8 bit
  313. Global Const WAVE_FORMAT_2M16 = &H40  ' 22.05  kHz, Mono,   16 bit
  314. Global Const WAVE_FORMAT_2S16 = &H80  ' 22.05  kHz, Stereo, 16 bit
  315. Global Const WAVE_FORMAT_4M08 = &H100 ' 44.1   kHz, Mono,   8 bit
  316. Global Const WAVE_FORMAT_4S08 = &H200 ' 44.1   kHz, Stereo, 8 bit
  317. Global Const WAVE_FORMAT_4M16 = &H400 ' 44.1   kHz, Mono,   16 bit
  318. Global Const WAVE_FORMAT_4S16 = &H800 ' 44.1   kHz, Stereo, 16 bit
  319.  
  320. Function checkformat (wavepath As String) As Integer
  321. 'check for the proper format tag
  322.  
  323. 'THIS will go into the RIFF wave file and grab the format tag
  324. 'any format tag of 16777728(actually 2) will not load.
  325. 'A format tag of 2 is a 16 bit compressed file,converted down to 4 or 8 bit files
  326. 'having trouble opening and then Closing these files.
  327. 'without this procedure there will be problems with format 2 files on
  328. 'some sound cards/drivers
  329.  
  330. 'It is a jerry rig at best but it Does work to prevent crashes
  331.  
  332. Dim fmt As Long, f As Integer
  333. Const UNCOMPRESSED = 16777472
  334. Const COMPRESSED = 16777728
  335.  
  336. f = FreeFile
  337.  
  338. Open wavepath For Binary As #f
  339.  
  340. 'go to the 20th byte,this is the format tag
  341. Get #f, 20, fmt
  342.  
  343. Close #f
  344.  
  345. Select Case fmt
  346.        Case UNCOMPRESSED
  347.          checkformat = True
  348.        Case COMPRESSED
  349.          checkformat = False
  350. End Select
  351.  
  352.  
  353. End Function
  354.  
  355. Sub CloseWavePlay ()
  356.     Dim dummy As Integer
  357.  
  358.     If hWaveSampleData <> 0 Then
  359.         dummy = GlobalFree(hWaveSampleData)
  360.     End If
  361.  
  362. End Sub
  363.  
  364. Function ExtendGlobalMemBlock (hMemoryBlock As Integer, OldLength As Long, NewLength As Long) As Integer
  365.     Dim hNewMemoryBlock As Integer
  366.     Dim lpNewMemoryBlock As Long
  367.     Dim lpMemoryBlock As Long
  368.     Dim dummy As Integer
  369.  
  370.     hNewMemoryBlock = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, NewLength)
  371.     lpMemoryBlock = GlobalLock(hMemoryBlock)
  372.     lpNewMemoryBlock = GlobalLock(hNewMemoryBlock)
  373.     hmemcpy lpNewMemoryBlock, lpMemoryBlock, OldLength
  374.     dummy = GlobalUnlock(hMemoryBlock)
  375.     hMemoryBlock = GlobalFree(hMemoryBlock)
  376.     dummy = GlobalUnlock(hNewMemoryBlock)
  377.     ExtendGlobalMemBlock = hNewMemoryBlock
  378. End Function
  379.  
  380. Function MaxInt (A As Integer, B As Integer) As Integer
  381.     If A > B Then
  382.         MaxInt = A
  383.       Else
  384.         MaxInt = B
  385.       End If
  386. End Function
  387.  
  388. Function MaxLong (A As Long, B As Long) As Long
  389.     If A > B Then
  390.         MaxLong = A
  391.       Else
  392.         MaxLong = B
  393.       End If
  394. End Function
  395.  
  396. Function MaxSingle (A As Single, B As Single) As Single
  397.     If A > B Then
  398.         MaxSingle = A
  399.       Else
  400.         MaxSingle = B
  401.       End If
  402. End Function
  403.  
  404. Function MinInt (A As Integer, B As Integer) As Integer
  405.     If A < B Then
  406.         MinInt = A
  407.       Else
  408.         MinInt = B
  409.       End If
  410. End Function
  411.  
  412. Function MinLong (A As Long, B As Long) As Long
  413.     If A < B Then
  414.         MinLong = A
  415.       Else
  416.         MinLong = B
  417.       End If
  418. End Function
  419.  
  420. Function MinSingle (A As Single, B As Single) As Single
  421.     If A < B Then
  422.         MinSingle = A
  423.       Else
  424.         MinSingle = B
  425.       End If
  426. End Function
  427.  
  428. Function OpenWaveFile (ByVal FileNameAndPath As String) As Integer
  429.     Dim dummy As Integer
  430.     Dim MMCKInfoParent As MMCKINFO
  431.     Dim MMCkInfoChild As MMCKINFO
  432.     Dim hMMIO As Integer
  433.     Dim ErrorCode As Integer
  434.     Dim BytesRead As Long
  435.     Dim Index As Integer
  436.     Dim lpWaveSampleData As Long
  437.     hMMIO = mmioOpen(FileNameAndPath, ByVal 0&, MMIO_READ)
  438.  
  439.     If hMMIO <> 0 Then
  440.         ' Find WAVE Parent Chunk
  441.         MMCKInfoParent.fccType.Chars = "WAVE"
  442.         
  443.         ErrorCode = mmioDescend(hMMIO, MMCKInfoParent, ByVal 0&, MMIO_FINDRIFF)
  444.        
  445.         If ErrorCode = 0 Then
  446.             ' Find fmt Chunk
  447.             MMCkInfoChild.CkId.Chars = "fmt "
  448.             ErrorCode = mmioDescend(hMMIO, MMCkInfoChild, MMCKInfoParent, MMIO_FINDCHUNK)
  449.            
  450.             If ErrorCode = 0 Then
  451.                 ' Read PCM Wave Format Record
  452.                 BytesRead = mmioRead(hMMIO, PCMWaveFmtRecord, MMCkInfoChild.CkSize)
  453.                  
  454.                 If BytesRead > 0 Then
  455.  
  456.           ErrorCode = waveOutOpen(hWaveOut, WAVE_MAPPER, PCMWaveFmtRecord, 0&, 0&, WAVE_FORMAT_QUERY)
  457.                   If ErrorCode <> 0 Then
  458.                        dummy = waveOutReset(hWaveOut)
  459.                        dummy = waveOutClose(hWaveOut)
  460.                    End If
  461.                     
  462.                     If ErrorCode = 0 Then
  463.                         ' Ascend back one level in the RIFF file.
  464.                           ErrorCode = mmioAscend(hMMIO, MMCkInfoChild, 0)
  465.                        If ErrorCode = 0 Then
  466.                             ' Read data chunk.
  467.                             MMCkInfoChild.CkId.Chars = "data"
  468.                             ErrorCode = mmioDescend(hMMIO, MMCkInfoChild, MMCKInfoParent, MMIO_FINDCHUNK)
  469.                             
  470.                             If ErrorCode = 0 Then
  471.                                 hWaveSampleData = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, MMCkInfoChild.CkSize)
  472.                                 
  473.                                 
  474.                                 If hWaveSampleData <> 0 Then
  475.                                     lpWaveSampleData = GlobalLock(hWaveSampleData)
  476.                                     
  477.                                     BytesRead = mmioReadToGlobal(hMMIO, lpWaveSampleData, MMCkInfoChild.CkSize)
  478.                                     lpWaveSampleData = GlobalUnlock(hWaveSampleData)
  479.                                     
  480.                                     If BytesRead > 0 Then
  481.                                         WaveHeader.lpData = 0
  482.                                         WaveHeader.dwBufferLength = BytesRead
  483.                                         WaveHeader.dwFlags = 0&
  484.                                         WaveHeader.dwLoops = 0&
  485.                                         OpenWaveFile = True
  486.                                     Else
  487.                                         MsgBox "Couldn't read wave data.", MB_ICONSTOP, "RIFF File Error"
  488.                                     End If
  489.                                 Else
  490.                                     MsgBox "Unable to Allocate Global Memory.", MB_ICONSTOP, "Memory Error"
  491.                                 End If
  492.                               Else
  493.                                 MsgBox "Couldn't find data chunk.", MB_ICONSTOP, "RIFF File Error"
  494.                               End If
  495.                           Else
  496.                             MsgBox "Couldn't ascend from fmt chunk.", MB_ICONSTOP, "RIFF File Error"
  497.                           End If
  498.                       Else
  499.                         MsgBox "Format not supported by Wave device.", MB_ICONSTOP, "Wave Data Error"
  500.                         
  501.                       End If
  502.                   Else
  503.                     MsgBox "Couldn't read wave format record.", MB_ICONSTOP, "RIFF File Error"
  504.                   End If
  505.               Else
  506.                 MsgBox "Couldn't find fmt chunk.", MB_ICONSTOP, "RIFF File Error"
  507.               End If
  508.           Else
  509.             MsgBox "Couldn't find WAVE parent chunk.", MB_ICONSTOP, "RIFF File Error"
  510.           End If
  511.           ' Close WAVE file.
  512.           ErrorCode = mmioClose(hMMIO, 0&)
  513.       Else
  514.        
  515.         MsgBox "Couldn't open file.", MB_ICONSTOP, "RIFF File Error"
  516.     End If
  517.  
  518. 'place wave files stats into picbox
  519. wavestats PCMWaveFmtRecord, waveplot, BytesRead, FileNameAndPath
  520.  
  521. End Function
  522.  
  523. Sub playwave ()
  524. 'play the wavefile
  525. Dim result As Integer
  526. Dim returnstring As String * 512
  527. Dim success As Integer
  528. Dim mcierrorstring As String * 256
  529. Dim commandstring As String
  530.  
  531. commandstring = "play " & wavepath
  532.  
  533. result = mcisendstring(commandstring, ByVal returnstring, Len(returnstring) - 1, 0)
  534.  
  535. success = mciGetErrorString(result, mcierrorstring, 255)
  536.  
  537. If success <> 1 Then
  538.    MsgBox mcierrorstring
  539. End If
  540.  
  541.  
  542. End Sub
  543.  
  544. Function PlotaWave (hTheWaveSampleData As Integer, f As Form, choice As Integer)
  545. Dim plot As Integer, curx As Single, cury As Single, filesize As Long, thestep As Integer
  546. Dim preplot  As Single
  547. Dim thecolor As Integer
  548. Dim sixteenplot As Integer
  549. Dim sixteenplot2 As Integer
  550.     
  551. Dim hNewWaveSampleData As Integer
  552. Dim lpTheWaveSampleData As Long
  553. Dim lpNewWaveSampleData As Long
  554. Dim SelWaveSampleData As Integer
  555. Dim LastSamplePosition As Long
  556. Dim Position As Long
  557. Dim BytesRead As Long
  558. 'Dim BytesWritten As Long
  559. Dim dummy As Integer
  560.  
  561. Dim MonoEightBitSample As MonoEightBitSamples
  562. Dim PrevMonoEightBitSample As MonoEightBitSamples
  563. 'Dim StereoEightBitSample As StereoEightBitSamples
  564. 'Dim PrevStereoEightBitSample As StereoEightBitSamples
  565. Dim MonoSixteenBitSample As MonoSixteenBitSamples
  566. Dim PrevMonoSixteenBitSample As MonoSixteenBitSamples
  567. 'Dim StereoSixteenBitSample As StereoSixteenBitSamples
  568. 'Dim PrevStereoSixteenBitSample As StereoSixteenBitSamples
  569. Const THELINE = 1
  570. Const THEPOINT = 2
  571. Const INCREMENT = 1
  572.     
  573.  
  574. curx = 0
  575. thecolor = 1
  576. f!Picture1.ScaleHeight = 700
  577. 'set the center line
  578. f!Picture1.CurrentY = f!Picture1.ScaleHeight / 2
  579. cury = f!Picture1.CurrentY
  580.          
  581. f!Picture1.DrawWidth = 1
  582. f!Picture1.CurrentX = 0
  583. f!Picture1.BackColor = QBColor(0)
  584.         
  585. 'Red center line(base line)
  586. f!Picture1.Line (curx, cury)-(f!Picture1.ScaleWidth, cury), QBColor(4)
  587.  
  588. Select Case WaveFormatConstantFromFormat(PCMWaveFmtRecord)
  589.        'Mono 8 bit  11025,22050,44100 kHz
  590.        Case WAVE_FORMAT_1M08, WAVE_FORMAT_2M08, WAVE_FORMAT_4M08
  591.        
  592.         hTheWaveSampleData = ExtendGlobalMemBlock(hTheWaveSampleData, WaveHeader.dwBufferLength, WaveHeader.dwBufferLength)
  593.         SelWaveSampleData = GlobalHandleToSel(hTheWaveSampleData)
  594.         LastSamplePosition = WaveHeader.dwBufferLength
  595.         'PrevMonoEightBitSample.Char = Chr$(128)
  596.   
  597. 'Since it is not possible to plot every single wave value on large
  598. 'wave files we must divide size of file by picture box width at time of plot
  599. 'this will give us a Step which will jump over some values,since
  600. 'there are so many values(11025 or so in a 11025 kHz per second)IN WAVE FILEs
  601. 'jumping over a few will not degrade the plotted wave display
  602. 'Remember that the wider your picturebox the more values(higher detail)
  603. 'will be displayed.
  604.  
  605.         'divide the file size by picturebox width
  606.         preplot = Abs(LastSamplePosition / f!Picture1.ScaleWidth)
  607.         thestep = CInt(preplot)
  608.    
  609.     '8 bit values above 128 are positive,values below are negative
  610.     
  611.    For Position = 0 To LastSamplePosition - 1 Step thestep
  612.      BytesRead = MemoryRead(SelWaveSampleData, Position, MonoEightBitSample, 1)
  613.     
  614.      'grab each sample and convert
  615.      plot = Asc(MonoEightBitSample.Char)
  616.      'convert to a 0 baseline (for 8 bit only)
  617.      plot = plot - 128
  618.         
  619.     'This is the STATIC plotting of the wave values
  620.      Select Case choice
  621.             Case THELINE    'small picture box
  622.                f!Picture1.Line (curx, cury)-(curx, cury + (plot * 4))
  623.             Case THEPOINT   'full screen picture box
  624.                f!Picture1.PSet (curx, cury + plot)
  625.     End Select
  626.    
  627.    'move CurrentX over 1
  628.    curx = curx + INCREMENT
  629.   
  630.   Next Position
  631.  
  632. Case WAVE_FORMAT_1S08, WAVE_FORMAT_2S08, WAVE_FORMAT_4S08
  633.         
  634.          Exit Function
  635.         
  636.         'Stereo 8-bit   'Need to add plotting code only
  637.         
  638.         'hTheWaveSampleData = ExtendGlobalMemBlock(hTheWaveSampleData, WaveHeader.dwBufferLength, WaveHeader.dwBufferLength)
  639.         'SelWaveSampleData = GlobalHandleToSel(hTheWaveSampleData)
  640.         'LastSamplePosition = WaveHeader.dwBufferLength
  641.         'PrevStereoEightBitSample.LeftChar = Chr$(128)
  642.         'PrevStereoEightBitSample.RightChar = Chr$(128)
  643.         
  644.         ' Initialize new bytes to midpoint value.
  645.        ' For Position = WaveHeader.dwBufferLength To LastSamplePosition Step 2
  646.         '    BytesWritten = MemoryWrite(SelWaveSampleData, Position, PrevStereoEightBitSample, 2)
  647.          '   Next Position
  648.         ' Mix in echo.
  649.        ' For Position = 0 To LastSamplePosition
  650.         '    BytesRead = MemoryRead(SelWaveSampleData, Position, StereoEightBitSample, 2)
  651.             ' Retrieve contents of byte at (Position-Period).
  652.          '   BytesRead = MemoryRead(SelWaveSampleData, Position, PrevStereoEightBitSample, 2)
  653.           '  StereoEightBitSample.LeftChar = Chr$(((Asc(StereoEightBitSample.LeftChar) - 128) + (Asc(PrevStereoEightBitSample.LeftChar) - 128) * GainFactor) \ 2 + 128)
  654.            ' StereoEightBitSample.RightChar = Chr$(((Asc(StereoEightBitSample.RightChar) - 128) + (Asc(PrevStereoEightBitSample.RightChar) - 128) * GainFactor) \ 2 + 128)
  655.            ' BytesWritten = MemoryWrite(SelWaveSampleData, Position, StereoEightBitSample, 2)
  656.            ' Next Position
  657.         
  658.       Case WAVE_FORMAT_1M16, WAVE_FORMAT_2M16, WAVE_FORMAT_4M16
  659.            'Mono 16-bit  11025,22050,44100 kHz
  660.         
  661.         hTheWaveSampleData = ExtendGlobalMemBlock(hTheWaveSampleData, WaveHeader.dwBufferLength, WaveHeader.dwBufferLength)
  662.         SelWaveSampleData = GlobalHandleToSel(hTheWaveSampleData)
  663.         LastSamplePosition = WaveHeader.dwBufferLength'
  664.         
  665.         preplot = Abs(LastSamplePosition / f!Picture1.ScaleWidth)
  666.         thestep = CInt(preplot)
  667.         
  668.        'thestep for 16 bit must be divisible by 2
  669.        'since we will go stepping through 2 samples at a time
  670.        Do While Not thestep Mod 2 = 0
  671.          thestep = thestep + 1
  672.        Loop
  673.        
  674.         For Position = 0 To LastSamplePosition - 1 Step thestep
  675.           ' Retrieve contents of byte
  676.           BytesRead = MemoryRead(SelWaveSampleData, Position, MonoSixteenBitSample, 2)
  677.           sixteenplot = MonoSixteenBitSample.Sample
  678.          
  679.          ' Retrieve contents of byte
  680.            BytesRead = MemoryRead(SelWaveSampleData, Position, PrevMonoSixteenBitSample, 2)
  681.            sixteenplot2 = PrevMonoSixteenBitSample.Sample
  682.            
  683.           '16 bit values are large so we will have to
  684.           'divide 16 bit values by 100  so they will fit into picbox
  685.           sixteenplot = sixteenplot \ 100
  686.           sixteenplot2 = sixteenplot2 \ 100
  687.          
  688.          'This is the plotting of the 16 bit wave values
  689.          'Select Case choice
  690.                 'Case THELINE    'small picture box
  691.                    f!Picture1.Line (curx, cury)-(curx, cury + sixteenplot)
  692.                    f!Picture1.Line (curx, cury)-(curx, cury + sixteenplot2)
  693.                 'Case THEPOINT   'full screen picture box
  694.                   ' f!Picture1.PSet (curX, curY + sixteenplot)
  695.                   ' f!Picture1.PSet (curX, curY + sixteenplot2)
  696.         'End Select
  697.    
  698.        'move CurrentX over 1
  699.        curx = curx + INCREMENT
  700.        
  701.      Next Position
  702.    
  703.    Case WAVE_FORMAT_1S16, WAVE_FORMAT_2S16, WAVE_FORMAT_4S16
  704.           
  705.         'Stereo 16-bit  'Need to add plotting code only
  706.           
  707.          
  708.         'hTheWaveSampleData = ExtendGlobalMemBlock(hTheWaveSampleData, WaveHeader.dwBufferLength, WaveHeader.dwBufferLength)
  709.         'SelWaveSampleData = GlobalHandleToSel(hTheWaveSampleData)
  710.         'LastSamplePosition = WaveHeader.dwBufferLength
  711.         '
  712.         'For Position = 0 To LastSamplePosition-1 Step 4
  713.          '   BytesRead = MemoryRead(SelWaveSampleData, Position, StereoSixteenBitSample, 4)
  714.             ' Retrieve contents of byte at (Position-Period).
  715.           '  BytesRead = MemoryRead(SelWaveSampleData, Position, PrevStereoSixteenBitSample, 4)
  716.            ' StereoSixteenBitSample.LeftSample = (StereoSixteenBitSample.LeftSample + PrevStereoSixteenBitSample.LeftSample
  717.            ' StereoSixteenBitSample.RightSample = (StereoSixteenBitSample.RightSample + PrevStereoSixteenBitSample.RightSample
  718.            ' BytesWritten = MemoryWrite(SelWaveSampleData, Position, StereoSixteenBitSample, 4)
  719.            ' Next Position
  720.         'WaveHeader.dwBufferLength = WaveHeader.dwBufferLength
  721.       End Select
  722.  
  723.  
  724. End Function
  725.  
  726. Function WaveFormatConstantFromFormat (ThePCMWaveFormatRecord As PCMWAVEFORMAT) As Long
  727.     Dim SampleRateFactor As Long
  728.     Dim ResolutionFactor As Long
  729.     Dim ChannelsFactor As Long
  730.     
  731.     SampleRateFactor = (Log(ThePCMWaveFormatRecord.wf.nSamplesPerSec \ 11025) / Log(2)) * 4
  732.     ResolutionFactor = (ThePCMWaveFormatRecord.wBitsPerSample \ 8 - 1) * 2
  733.     ChannelsFactor = ThePCMWaveFormatRecord.wf.nChannels - 1
  734.     WaveFormatConstantFromFormat = 2 ^ (SampleRateFactor + ResolutionFactor + ChannelsFactor)
  735. End Function
  736.  
  737. Function WaveFormatStringFromConstant (FormatNumber As Long)
  738.     Dim result As String
  739.  
  740.     Select Case FormatNumber
  741.       Case WAVE_FORMAT_1M08
  742.           result = "11.025 kHz, Mono,   8 bit"
  743.       Case WAVE_FORMAT_1S08
  744.           result = "11.025 kHz, Stereo,  8 bit"
  745.       Case WAVE_FORMAT_1M16
  746.           result = "11.025 kHz, Mono,   16 bit"
  747.       Case WAVE_FORMAT_1S16
  748.           result = "11.025 kHz, Stereo,  16 bit"
  749.       Case WAVE_FORMAT_2M08
  750.           result = "22.05  kHz, Mono,   8 bit"
  751.       Case WAVE_FORMAT_2S08
  752.           result = "22.05  kHz, Stereo, 8 bit"
  753.       Case WAVE_FORMAT_2M16
  754.           result = "22.05  kHz, Mono,   16 bit"
  755.       Case WAVE_FORMAT_2S16
  756.           result = "22.05  kHz, Stereo, 16 bit"
  757.       Case WAVE_FORMAT_4M08
  758.           result = "44.1   kHz, Mono,   8 bit"
  759.       Case WAVE_FORMAT_4S08
  760.           result = "44.1   kHz, Stereo, 8 bit"
  761.       Case WAVE_FORMAT_4M16
  762.           result = "44.1   kHz, Mono,   16 bit"
  763.       Case WAVE_FORMAT_4S16
  764.           result = "44.1   kHz, Stereo, 16 bit"
  765.       Case Else
  766.           result = "Invalid Wave Format"
  767.       End Select
  768.     WaveFormatStringFromConstant = result
  769.     End Function
  770.  
  771. Function WaveFunctionStringFromConstant (FunctionNumber As Long)
  772.     Dim result As String
  773.  
  774.     Select Case FunctionNumber
  775.       Case WAVECAPS_PITCH
  776.           result = "Pitch Control"
  777.       Case WAVECAPS_PLAYBACKRATE
  778.           result = "Playback Rate Control"
  779.       Case WAVECAPS_VOLUME
  780.           result = "Volume Control"
  781.       Case WAVECAPS_LRVOLUME
  782.           result = "Separate Left-Right Volume Control"
  783.       Case WAVECAPS_SYNC
  784.           result = "Synchronization"
  785.       Case Else
  786.           result = "Invalid Function"
  787.       End Select
  788.     WaveFunctionStringFromConstant = result
  789. End Function
  790.  
  791. Function WaveOut () As Integer
  792.     Dim hWaveOut As Integer
  793.     Dim ReturnCode As Integer
  794.     Dim wavepos As Integer
  795.     Dim wavetime As MMTIME
  796.     Dim wvtm As Single
  797.     Dim curx As Single
  798.     Dim wavepoint As Single
  799.     Dim oldwidth As Single
  800.     Const EIGHT = 8
  801.     Const SIXTEEN = 16
  802.     
  803.     WaveHeader.lpData = GlobalLock(hWaveSampleData)'lstrcpy(WaveBuffer(1), WaveBuffer(1))
  804.     ' Open the wave device.
  805.     ReturnCode = waveOutOpen(hWaveOut, WAVE_MAPPER, PCMWaveFmtRecord, 0&, 0&, 0&)
  806.  
  807.     If ReturnCode = 0 Then
  808.         ' Prepare the wave output header.
  809.         
  810.         ReturnCode = waveOutPrepareHeader(hWaveOut, WaveHeader, Len(WaveHeader))
  811.         
  812.         If ReturnCode = 0 Then
  813.             ' Write the wave data to the output device.
  814.             ReturnCode = waveOutWrite(hWaveOut, WaveHeader, Len(WaveHeader))
  815.             
  816.             'get the increment for pointer to keep track of wave position
  817.             'on the plotted display
  818.             
  819.              oldwidth = waveplot!Picture1.ScaleWidth
  820.              
  821.               Select Case PCMWaveFmtRecord.wBitsPerSample
  822.                      Case Is = EIGHT
  823.                          wavepoint = (plottime * 106)   '8 bit
  824.                      Case Is = SIXTEEN
  825.                          wavepoint = (plottime * 115)   '16 bit
  826.               End Select
  827.  
  828.              waveplot!Picture1.ScaleWidth = wavepoint
  829.            
  830.             If ReturnCode = 0 Then
  831.                 
  832.                 'display the time in a picture box,if you use a label control
  833.                 'you will get severe flicker
  834.                
  835.                 Do Until (WaveHeader.dwFlags And WHDR_DONE)
  836.                   DoEvents
  837.                    'display the time position of playback
  838.                    wavepos = waveOutGetPosition(hWaveOut, wavetime, Len(wavetime))
  839.                    wvtm = wavetime.units / PCMWaveFmtRecord.wf.nAvgBytesPerSec
  840.                    
  841.                    waveplot!picwavetime.Cls
  842.                    waveplot!picwavetime.CurrentX = 0
  843.                    waveplot!picwavetime.CurrentY = 0
  844.                    waveplot!picwavetime.Print Format$(wvtm, "00:00.#0")
  845.                    waveplot!Shape1.Left = waveplot!Shape1.Left + 2 'red pointer
  846.                   
  847.                 Loop
  848.               
  849.             End If
  850.             'reset
  851.             waveplot!Shape1.Left = 0
  852.             waveplot!Picture1.ScaleMode = 1
  853.             waveplot!Picture1.ScaleWidth = oldwidth
  854.  
  855.             WaveOut = True
  856.             ' Unprepare the wave output header.
  857.             ReturnCode = waveOutUnprepareHeader(hWaveOut, WaveHeader, Len(WaveHeader))
  858.             If ReturnCode <> 0 Then
  859.                 MsgBox "Unable to Unprepare Wave Header", MB_ICONSTOP, "Wave Error"
  860.               End If
  861.             WaveHeader.dwFlags = 0
  862.             ' Close the wave device.
  863.             ReturnCode = waveOutClose(hWaveOut)
  864.             If ReturnCode <> 0 Then
  865.                 MsgBox "Unable to Close Wave Device", MB_ICONSTOP, "Wave Error"
  866.               End If
  867.           Else
  868.             ' Couldn't prepare the header, so close the device.
  869.             MsgBox "Unable to Prepare Wave Header", 0, "Wave Error"
  870.             ReturnCode = waveOutClose(hWaveOut)
  871.             If ReturnCode <> 0 Then
  872.                 MsgBox "Unable to Close Wave Device", MB_ICONSTOP, "Wave Error"
  873.               End If
  874.           End If
  875.       Else
  876.         ' Couldn't open the device so do nothing.
  877.         MsgBox "Unable to Open Wave Device", MB_ICONSTOP, "Wave Error"
  878.       End If
  879.     WaveHeader.lpData = GlobalUnlock(hWaveSampleData)
  880. End Function
  881.  
  882. Sub wavestats (stats As PCMWAVEFORMAT, f As Form, bytes As Long, thepath As String)
  883. 'place the wave file stats into picbox
  884. Const MONO = 1
  885. Const STEREO = 2
  886. On Error Resume Next
  887.  
  888. f!pic_stats.Cls
  889. f!pic_stats.CurrentX = 0: f!pic_stats.CurrentY = 0
  890. f!pic_stats.Print "Sampling " & stats.wf.nSamplesPerSec & " Hz"
  891.  
  892. 'get the time length of data samples
  893. plottime = bytes / stats.wf.nAvgBytesPerSec
  894. f!pic_stats.Print "Length    " & Format$(plottime, "##.#0"); " Seconds"
  895.  
  896. Select Case stats.wf.nChannels
  897.        Case MONO
  898.          f!pic_stats.Print "Channels " & "Mono " & stats.wBitsPerSample; " Bit"
  899.        Case STEREO
  900.         f!pic_stats.Print "Channels " & "Stereo " & stats.wBitsPerSample; " Bit"
  901. End Select
  902.  
  903. f!pic_stats.Print thepath
  904.  
  905. End Sub
  906.  
  907.